home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / GRAPHICS / IMGLIB95 / UICONLB.PA_ / UICONLB.PA
Text File  |  1996-03-31  |  10KB  |  344 lines
  1. {
  2. Written by Jan Dekkers and Kevin Adams (c) 1995, 1996. If you are a non
  3. registered client, you may use or alter this demo only for evaluation
  4. purposes.
  5.  
  6. Copyright by SkyLine Tools. All rights reserved.
  7.  
  8. Part of Imagelib VCL/DLL Library.
  9. }
  10.  
  11. unit UIconLB;
  12.  
  13. {Includes settings to compile in either 16 or 32 bit}
  14. {$I DEFILIB.INC}
  15.  
  16. interface
  17.  
  18. uses
  19. {$IFDEF DEL32}
  20.  Windows,
  21. {$ELSE}
  22.  WinTypes,
  23.  WinProcs,
  24. {$ENDIF}
  25.  DLL95V1,     {ImageLib Dll interface and misc. functions}
  26.  Classes,
  27.  Graphics,
  28.  Forms,
  29.  Controls,
  30.  Buttons,
  31.  StdCtrls,
  32.  DBTables,
  33.  DB,
  34.  SysUtils,
  35.  ExtCtrls,
  36.  Mask,
  37.  DBCtrls,
  38.  Dialogs,
  39.  Tdbicon;     {TDBIconEditor, TDBIconListBox, TDBIconComboBox VCL component}     
  40. {-----------------------------------------------------------------------}
  41.  
  42. type
  43.   TIconListBoxDlg = class(TForm)
  44.     CancelBtn: TBitBtn;
  45.     SrcLabel: TLabel;
  46.     DstLabel: TLabel;
  47.     IncludeBtn: TSpeedButton;
  48.     IncAllBtn: TSpeedButton;
  49.     ExcludeBtn: TSpeedButton;
  50.     ExAllBtn: TSpeedButton;
  51.     Table1: TTable;
  52.     BitBtn2: TBitBtn;
  53.     SrcList: TDBIconListBox;
  54.     CheckBox1: TCheckBox;
  55.     DBIconComboBox1: TDBIconComboBox;
  56.     Label1: TLabel;
  57.     DBIconEditor1: TDBIconEditor;
  58.     DstList: TDBIconListBox;
  59.     procedure IncludeBtnClick(Sender: TObject);
  60.     procedure ExcludeBtnClick(Sender: TObject);
  61.     procedure IncAllBtnClick(Sender: TObject);
  62.     procedure ExcAllBtnClick(Sender: TObject);
  63.     procedure MoveSelected(List: TCustomListBox; Items: TStrings);
  64.     procedure SetItem(List: TListBox; Index: Integer);
  65.     procedure SetItem2(List: TListBox; Index: Integer);
  66.     function GetFirstSelection(List: TCustomListBox): Integer;
  67.     procedure SetButtons;
  68.     procedure FormCreate(Sender: TObject);
  69.     procedure BitBtn2Click(Sender: TObject);
  70.     procedure CancelBtnClick(Sender: TObject);
  71.     procedure CheckBox1Click(Sender: TObject);
  72.     procedure DstListDragOver(Sender, Source: TObject; X, Y: Integer;
  73.       State: TDragState; var Accept: Boolean);
  74.     procedure SrcListMouseDown(Sender: TObject; Button: TMouseButton;
  75.       Shift: TShiftState; X, Y: Integer);
  76.     procedure SrcListDragOver(Sender, Source: TObject; X, Y: Integer;
  77.       State: TDragState; var Accept: Boolean);
  78.     procedure DstListMouseDown(Sender: TObject; Button: TMouseButton;
  79.       Shift: TShiftState; X, Y: Integer);
  80.     procedure DstListDragDrop(Sender, Source: TObject; X, Y: Integer);
  81.     procedure SrcListDragDrop(Sender, Source: TObject; X, Y: Integer);
  82.   private
  83.     Procedure AddListBoxItems;
  84.   public
  85.     { Public declarations }
  86.   end;
  87.  
  88. var
  89.   IconListBoxDlg : TIconListBoxDlg;
  90.  
  91. implementation
  92.  
  93. {$R *.DFM}
  94.  
  95. procedure TIconListBoxDlg.IncludeBtnClick(Sender: TObject);
  96. var
  97.   Index: Integer;
  98. begin
  99.   Index := GetFirstSelection(SrcList);
  100.   MoveSelected(SrcList, DstList.Items);
  101.   SetItem(SrcList, Index);
  102. end;
  103. {-----------------------------------------------------------------------}
  104.  
  105. procedure TIconListBoxDlg.ExcludeBtnClick(Sender: TObject);
  106. var
  107.   Index: Integer;
  108. begin
  109.   Index := GetFirstSelection(DstList);
  110.   MoveSelected(DstList, SrcList.Items);
  111.   SetItem(DstList, Index);
  112. end;
  113. {-----------------------------------------------------------------------}
  114.  
  115. procedure TIconListBoxDlg.IncAllBtnClick(Sender: TObject);
  116. var
  117.   I: Integer;
  118. begin
  119.   for I := 0 to SrcList.Items.Count - 1 do begin
  120.      DstList.Items.AddObject(SrcList.Items[I], SrcList.Items.Objects[I]);
  121.   end;
  122.   SrcList.Items.Clear;
  123.   SetItem(SrcList, 0);
  124. end;
  125. {-----------------------------------------------------------------------}
  126.  
  127. procedure TIconListBoxDlg.ExcAllBtnClick(Sender: TObject);
  128. var
  129.   I: Integer;
  130. begin
  131.   for I := 0 to DstList.Items.Count - 1 do
  132.     SrcList.Items.AddObject(DstList.Items[I], DstList.Items.Objects[I]);
  133.   DstList.Items.Clear;
  134.   SetItem(DstList, 0);
  135. end;
  136. {-----------------------------------------------------------------------}
  137.  
  138. procedure TIconListBoxDlg.MoveSelected(List: TCustomListBox; Items: TStrings);
  139. var
  140.   I: Integer;
  141. begin
  142.   for I := List.Items.Count - 1 downto 0 do
  143.     if List.Selected[I] then
  144.     begin
  145.       Items.AddObject(List.Items[I], List.Items.Objects[I]);
  146.       List.Items.Delete(I);
  147.     end;
  148. end;
  149. {-----------------------------------------------------------------------}
  150.  
  151. procedure TIconListBoxDlg.SetButtons;
  152. var
  153.   SrcEmpty, DstEmpty: Boolean;
  154. begin
  155.   SrcEmpty := SrcList.Items.Count = 0;
  156.   DstEmpty := DstList.Items.Count = 0;
  157.   IncludeBtn.Enabled := not SrcEmpty;
  158.   IncAllBtn.Enabled := not SrcEmpty;
  159.   ExcludeBtn.Enabled := not DstEmpty;
  160.   ExAllBtn.Enabled := not DstEmpty;
  161. end;
  162. {-----------------------------------------------------------------------}
  163.  
  164. function TIconListBoxDlg.GetFirstSelection(List: TCustomListBox): Integer;
  165. begin
  166.   for Result := 0 to List.Items.Count - 1 do
  167.     if List.Selected[Result] then Exit;
  168.   Result := LB_ERR;
  169. end;
  170. {-----------------------------------------------------------------------}
  171.  
  172. procedure TIconListBoxDlg.SetItem(List: TListBox; Index: Integer);
  173. var
  174.   MaxIndex: Integer;
  175. begin
  176.   with List do
  177.   begin
  178.     SetFocus;
  179.     MaxIndex := List.Items.Count - 1;
  180.     if Index = LB_ERR then Index := 0
  181.     else if Index > MaxIndex then Index := MaxIndex;
  182.     Selected[Index] := True;
  183.   end;
  184.   SetButtons;
  185. end;
  186. {-----------------------------------------------------------------------}
  187.  
  188. procedure TIconListBoxDlg.FormCreate(Sender: TObject);
  189. begin
  190.     Table1.DataBaseName:=ExtractFilePath(Application.ExeName);
  191.     Table1.Active:=True;
  192.     AddListBoxItems;
  193. end;
  194. {-----------------------------------------------------------------------}
  195.  
  196. procedure TIconListBoxDlg.BitBtn2Click(Sender: TObject);
  197. begin
  198.   If DBIconEditor1.Execute then
  199.    AddListBoxItems;
  200. end;
  201. {-----------------------------------------------------------------------}
  202.  
  203. Procedure TIconListBoxDlg.AddListBoxItems;
  204.  begin
  205.     Table1.First;
  206.     SrcList.Items.Clear;
  207.     DBIconComboBox1.Items.Clear;
  208.     While not Table1.EOF do begin
  209.      SrcList.Items.Add(Table1.FieldByName('ICONDESC').AsString);
  210.      DBIconComboBox1.Items.Add(Table1.FieldByName('ICONDESC').AsString);
  211.      Table1.Next;
  212.    end;
  213.  end;
  214. {-----------------------------------------------------------------------}
  215.  
  216. procedure TIconListBoxDlg.SetItem2(List: TListBox; Index: Integer);
  217. var
  218.   MaxIndex: Integer;
  219. begin
  220.   with List do
  221.   begin
  222.     SetFocus;
  223.     MaxIndex := List.Items.Count - 1;
  224.     if Index = LB_ERR then Index := 0
  225.     else if Index > MaxIndex then Index := MaxIndex;
  226.     Selected[Index] := True;
  227.   end;
  228. end;
  229. {-----------------------------------------------------------------------}
  230.  
  231. procedure TIconListBoxDlg.CancelBtnClick(Sender: TObject);
  232. begin
  233.   Close;
  234. end;
  235. {-----------------------------------------------------------------------}
  236.  
  237. procedure TIconListBoxDlg.CheckBox1Click(Sender: TObject);
  238. begin
  239.   SrcList.ShowIcons:=CheckBox1.Checked;
  240.   if CheckBox1.Checked then begin
  241.      SrcList.Style:=lbOwnerDrawFixed;
  242.      SrcList.ItemHeight:=36
  243.   end else begin
  244.      SrcList.Style:=lbStandard;
  245.      SrcList.ItemHeight:=14;
  246.   end;
  247. end;
  248. {-----------------------------------------------------------------------}
  249.  
  250. procedure TIconListBoxDlg.DstListDragOver(Sender, Source: TObject; X,
  251.   Y: Integer; State: TDragState; var Accept: Boolean);
  252.  
  253. begin
  254.   if Source is TListbox then
  255.     if TListbox(Source).Name = 'SrcList' then
  256.      Accept:=true else Accept:=False;
  257. end;
  258. {-----------------------------------------------------------------------}
  259.  
  260. procedure TIconListBoxDlg.SrcListDragOver(Sender, Source: TObject; X,
  261.   Y: Integer; State: TDragState; var Accept: Boolean);
  262. begin
  263.   if Source is TListbox then
  264.     if TListbox(Source).Name = 'DstList' then
  265.      Accept:=true else Accept:=False;
  266. end;
  267. {-----------------------------------------------------------------------}
  268.  
  269. procedure TIconListBoxDlg.SrcListMouseDown(Sender: TObject;
  270.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  271. begin
  272.   if ssShift in Shift then exit;
  273.   if Button = mbLeft then
  274.     with Sender as TListBox do
  275.     begin
  276.       if ItemAtPos(Point(X, Y), True) >= 0 then
  277.         BeginDrag(False);
  278.     end;
  279. end;
  280. {-----------------------------------------------------------------------}
  281.  
  282. procedure TIconListBoxDlg.DstListMouseDown(Sender: TObject;
  283.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  284. begin
  285.   if ssShift in Shift then exit;
  286.   if Button = mbLeft then
  287.     with Sender as TListBox do
  288.     begin
  289.       if ItemAtPos(Point(X, Y), True) >= 0 then
  290.         BeginDrag(False);
  291.     end;
  292. end;
  293. {-----------------------------------------------------------------------}
  294.  
  295.  
  296. procedure TIconListBoxDlg.DstListDragDrop(Sender, Source: TObject; X,
  297.   Y: Integer);
  298.  
  299. var
  300.   Index: Integer;
  301. begin
  302.   if Source is TListbox then
  303.     if TListbox(Source).Name = 'SrcList' then begin
  304.      Index := GetFirstSelection(SrcList);
  305.      MoveSelected(SrcList, DstList.Items);
  306.      SetItem(SrcList, Index);
  307.     end;
  308. end;
  309. {-----------------------------------------------------------------------}
  310.  
  311.  
  312. procedure TIconListBoxDlg.SrcListDragDrop(Sender, Source: TObject; X,
  313.   Y: Integer);
  314. var
  315.   Index: Integer;
  316. begin
  317.   if Source is TListbox then
  318.     if TListbox(Source).Name = 'DstList' then begin
  319.      Index := GetFirstSelection(DstList);
  320.      MoveSelected(DstList, SrcList.Items);
  321.      SetItem(DstList, Index);
  322.     end;
  323. end;
  324. {-----------------------------------------------------------------------}
  325. {-----------------------------------------------------------------------}
  326.  
  327. initialization
  328.  
  329. end.
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  
  342.  
  343.  
  344.